Pascal Super Library/Pascal Super Library (CW International)(1997).bin/TSR/TSRSRC35/MEMU.PAS

Pascal/Delphi Source File | 1993-10-21 | 30KB | 1,039 lines

{**************************************************************************
*   MEMU - utility unit for TSR Utilities.                                *
*   Copyright (c) 1991,1993 Kim Kokkonen, TurboPower Software.            *
*   May be freely distributed and used but not sold except by permission. *
*                                                                         *
*   Version 3.0 9/24/91                                                   *
*     first release                                                       *
*   Version 3.1 11/4/91                                                   *
*     update for new WATCH identification behavior                        *
*     update HasEnvironment for programs that shrink env size to 0        *
*   Version 3.2 11/22/91                                                  *
*     add FindHiMemStart function to generalize high memory access        *
*     modify FindTheBlocks for new high memory approach                   *
*     add MergeHiMemBlocks procedure to merge memory blocks in hi mem     *
*     add ValidPsp function to determine whether a Psp still exists       *
*   Version 3.3 1/8/92                                                    *
*     add NextArg function to parse command lines more flexibly           *
*   Version 3.4 2/14/92                                                   *
*     change NextArg to ignore embedded '-'                               *
*     change FindTheBlocks to support new /L switches in MAPMEM, DISABLE  *
*     change StripNonAscii to allow European accented characters          *
*   Version 3.5 10/11/93                                                  *
*     change FindHiMemStart to use either the DOS UMB link or the old     *
*       empirical method                                                  *
*     add GetCDCount to get information about MSCDEX CD-ROMs used by      *
*       MARKNET and RELNET                                                *
***************************************************************************}

{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}

unit MemU;
  {-Miscellaneous memory functions needed for TSR Utilities}

interface

const
  {!!!!!! Following may change when WATCH reassembled. Check WATCH.MAP !!!!!}
  ChangeVectors = $320;
  OrigVectors = $720;

  {Offsets into resident copy of WATCH.COM for data storage}
  WatchOfs = $80;             {Location of length of command line}
  WatchOffset = $81;          {Location of start of command line}
  NextChange = $104;          {Data structures within WATCH}
  WatchId = 'TSR WATCHER';    {ID placed in WATCH command line}
  MaxChanges = 128;           {Maximum number of vector changes stored in WATCH}

  Version = '3.5';            {TSR Utilities version number}
  MarkID  = 'MM3.5 TSR';      {Marking string for TSR MARK}
  FmarkID = 'FM3.5 TSR';      {Marking string for TSR file mark}
  NmarkID = 'MN3.5 TSR';      {Marking string for TSR file mark}
  NetMarkID = 'MN35';         {ID at start of net mark file}

  {Offsets into resident mark copies for id strings}
  MarkOffset = $103;          {Where markID is found in MARK TSR}
  FmarkOffset = $60;          {Where FmarkID is found in FMARK TSR}
  NmarkOffset = $60;          {Where NmarkID is found in FMARK TSR}

  {Offsets into resident copy of MARK for data storage}
  VectorOffset = $120;        {Where vector table is stored}
  EGAsavOffset = $520;        {Where the EGA save save is stored}
  IntComOffset = $528;        {Where the interapps comm area is stored}
  ParentOffset = $538;        {(TER) Where parent's PSP segment is stored}
  ParLenOffset = $53A;        {Where parent's PSP mcb length is stored}
  EMScntOffset = $53C;        {Where count of EMS active pages is stored}
  EMSmapOffset = $53E;        {Where the page map is stored}

const
  MaxBlocks = 256;            {Max number of DOS allocation blocks supported}

  ProtectChar = '!';          {Marks whose name begins with this will be
                               released ONLY if an exact name match occurs}

const
  RBR = 0; {Receiver buffer register offset}
  THR = 0; {Transmitter buffer register offset}
  BRL = 0; {Baud rate low}
  BRH = 1; {Baud rate high}
  IER = 1; {Interrupt enable register}
  IIR = 2; {Interrupt identification register}
  LCR = 3; {Line control register}
  MCR = 4; {Modem control register}
  LSR = 5; {Line status register}
  MSR = 6; {Modem status register}

type
  OS =
    record
      O, S : Word;
    end;

  StringPtr = ^String;

  NameArray = array[1..8] of Char;

  McbPtr = ^Mcb;
  Mcb =
    record
      Id : Char;
      Psp : Word;
      Len : Word;
      Unused : array[1..3] of Byte;
      Name : NameArray;
    end;

  Block =
  record                      {Store info about each memory block}
    mcb : Word;
    psp : Word;
    releaseIt : Boolean;
  end;

  BlockType = 0..MaxBlocks;
  BlockArray = array[1..MaxBlocks] of Block;

  McbGroup =
  record
    Count : Word;
    Mcbs : array[1..MaxBlocks] of
           record
             mcb : Word;
             psp : Word;
           end;
  end;

  ChangeBlock =
  record                      {Store info about each vector takeover}
    VecNum : byte;
    case ID : byte of
      0, 1 : (VecOfs, VecSeg : Word);
      2    : (SaveCode : array[1..6] of byte);
      $FF  : (PspAdd : Word);
  end;
  {
  ID is interpreted as follows:
    00 = ChangeBlock holds the new pointer for vector vecnum
    01 = ChangeBlock holds pointer for vecnum but the block is disabled
    02 = ChangeBlock holds the code underneath the vector patch
    FF = ChangeBlock holds the segment of a new PSP
  }
  ChangeArray = array[0..MaxChanges] of ChangeBlock;

  {Structure of a device driver header}
  DeviceHeader =
    record
      NextHeaderOffset : Word;    {Offset address of next device in chain}
      NextHeaderSegment : Word;   {Segment address of next device in chain}
      Attributes : Word;          {Device attributes}
      StrategyEntPt : Word;       {Offset in current segment - strategy}
      InterruptEntPt : Word;      {Offset in current segment - interrupt}
      DeviceName : array[1..8] of Char; {Name of the device}
    end;
  DeviceHeaderPtr = ^DeviceHeader;
  DeviceArray = array[1..256] of DeviceHeaderPtr;

  CDROMDeviceHeader =
    record
      NextHeaderOffset : Word;    {Offset address of next device in chain}
      NextHeaderSegment : Word;   {Segment address of next device in chain}
      Attributes : Word;          {Device attributes}
      StrategyEntPt : Word;       {Offset in current segment - strategy}
      InterruptEntPt : Word;      {Offset in current segment - interrupt}
      DeviceName : array[1..8] of Char; {Name of the device}
      Reserved : Word;            {CD extensions}
      DriveLet : Byte;
      UnitCount : Byte;
    end;
  CDROMDeviceHeaderPtr = ^CDROMDeviceHeader;

  FileRec =
    record
      OpenCnt : Word;
      OpenMode : Word;
      Attribute : Byte;
      Unknown1 : Word;
      DCB : Pointer;
      InitCluster : Word;
      Time : Word;
      Date : Word;
      Size : LongInt;
      Pos : LongInt;
      BeginCluster : Word;
      CurCluster : Word;
      Block : Word;
      Unknown2 : Byte;            {Varies with DOS version beyond here}
      Name : array[0..7] of Char;
      Ext : array[0..2] of Char;
      Unknown3 : array[0..5] of Byte;
      Owner : Word;
      Unknown4 : Word;
    end;

  SftRecPtr = ^SftRec;
  SftRec =
    record
      Next : SftRecPtr;
      Count : Word;
      Files : array[1..255] of FileRec;
    end;

  CurDirRec =
    record
      DrivePath : array[0..66] of Char;
      Flags : Word;
      DPB : Pointer;
      RedirIfs : Pointer;
      Param : Word;
      BackSlashOfs : Word;
      Dummy : array[1..7] of Byte; {Only for DOS 4.0+}
    end;
  CurDirRecPtr = ^CurDirRec;

  DosRec =
    record
      McbSeg : Word;
      FirstDPB : Pointer;
      FirstSFT : SftRecPtr;
      ClockDriver : Pointer;
      ConDriver : Pointer;
      MaxBlockBytes : Word;
      CachePtr : Pointer;
      CurDirTable : CurDirRecPtr;
      FcbTable : Pointer;
      ProtectedFcbCount : Word;
      BlockDevices : Byte;
      LastDrive : Byte;
      NullDevice : DeviceHeader;
      JoinedDrives : Byte;           {Following valid DOS 4.0 or later}
      SpecialProgOfs : Word;
      IFSPtr : Pointer;
      IFSList : Pointer;
      BuffersX : Word;
      BuffersY : Word;
      BootDrive : Byte;
      Unknown1 : Byte;
      ExtMemSize : Word;
    end;
  DosRecPtr = ^DosRec;

  ComRec =  {State of the communications system}
    record
      Base : Word;
      IERReg : Byte;
      LCRReg : Byte;
      MCRReg : Byte;
      BRLReg : Byte;
      BRHReg : Byte;
    end;
  ComArray = array[1..2] of ComRec;

  CDROMDeviceRec =
    record
      SubUnit : Byte;
      Header : CDROMDeviceHeaderPtr;
    end;
  CDROMDeviceArray = array[1..26] of CDROMDeviceRec;

const
  Digits : array[0..$F] of Char = '0123456789ABCDEF';
  DosDelimSet : set of Char = ['\', ':', #0];

var
  DosVM : Byte;      {Minor DOS version number}
  DosV : Byte;       {Major DOS version number}
  DosVT : Word absolute DosVM; {Combined version number}
  DosList : Pointer; {Pointer to DOS list of lists}
  Mcb1 : McbPtr;     {First MCB in system}

function GetDosListPtr : Pointer;
  {-Return address of DOS list of lists}

function GetUmbLinkStatus : Boolean;
  {-Return status of DOS 5 upper memory block link}

function SetUmbLinkStatus(On : Boolean) : Word;
  {-Change state of DOS 5 upper memory block link}

function DosVersion : Word;
  {-Return DOS version number with high byte = major version number}

function TopOfMemSeg : Word;
  {-Return segment of top of normal memory}

function FindHiMemStart : word;
  {-Return segment of first mcb in high memory, 0 if none}

procedure MergeHiMemBlocks(HiMemSeg : Word);
  {-Merge adjacent blocks in high memory, starting with HiMemSeg}

function HexB(B : Byte) : String;
  {-Return hex string for byte}

function HexW(W : Word) : String;
  {-Return hex string for word}

function HexPtr(P : Pointer) : string;
  {-Return hex string for pointer}

function StUpcase(S : String) : String;
  {-Return the uppercase string}

function JustFilename(PathName : String) : String;
  {-Return just the filename of a pathname}

function JustName(PathName : String) : String;
  {-Return just the name (no extension, no path) of a pathname}

function Extend(S : String; Len : Byte) : String;
  {-Truncate or pad S to length Len}

function SmartExtend(S : String; Len : Byte) : String;
  {-Truncate or pad S to length Len; end with '...' if truncated}

function Asc2Str(Name : NameArray) : String;
  {-Convert array[1..8] of char to string}

procedure StripNonAscii(var S : String);
  {-Return an empty string if input contains non-ASCII characters}

function CommaIze(L : LongInt; Width : Byte) : String;
  {-Convert L to a string and add commas for thousands}

function HasEnvironment(HiMemSeg : Word; M : McbPtr) : Boolean;
  {-Return True if M has an associated environment block}

function ValidPsp(HiMemSeg, PspSeg, PspLen : Word) : Boolean;
  {-Return True if PspSeg is a valid, existing Psp}

function NameFromEnv(M : McbPtr) : String;
  {-Return M's name from its environment (already known to exist)}

function NameFromMcb(M : McbPtr) : String;
  {-Return name from the Mcb (DOS 4+ only)}

function MasterCommandSeg(HiMemSeg : Word) : Word;
  {-Return PSP segment of master COMMAND.COM, searching high memory first}

function WatchPspSeg : Word;
  {-Find copy of WATCH.COM in memory, returning its PSP segment or 0}

procedure FindTheBlocks(UseLoMem : Boolean;
                        HiMemSeg : Word;
                        var Blocks : BlockArray;
                        var BlockMax : BlockType;
                        var StartMcb : Word);
  {-Scan memory for the allocated memory blocks}

procedure StuffKey(W : Word);
  {-Stuff one key into the keyboard buffer}

procedure StuffKeys(Keys : string; ClearFirst : Boolean);
  {-Stuff up to 16 keys into keyboard buffer}

function ExistFile(path : String) : Boolean;
  {-Return true if file exists}

function NextArg(S : String; var SPos : Word) : String;
  {-Return next argument beginning at SPos in S.
    Increment SPos to point past the argument.
    Arguments are delimited by white space, and '/'.}

procedure IntsOff;
  {-Turn off CPU interrupts}
inline($FA);

procedure IntsOn;
  {-Turn on CPU interrupts}
inline($FB);

procedure NullJump;
  {-Slight delay}
inline($EB/$00);

function GetCDCount(var CDInfo : CDROMDeviceArray) : Word;
  {-Return number of MSCDEX CD-ROMs and info about them}

  {=======================================================================}

implementation

uses
  xms;

  function GetDosListPtr : Pointer; Assembler;
    {-Return address of DOS list of lists}
  asm
    mov     ah,$52
    int     $21
    mov     dx,es
    mov     ax,bx
  end;

  function GetUmbLinkStatus : Boolean; Assembler;
    {-Return status of DOS 5 upper memory block link}
  asm
    mov     ax,$5802
    int     $21
  end;

  function SetUmbLinkStatus(On : Boolean) : Word; Assembler;
    {-Change state of DOS 5 upper memory block link}
  asm
    mov     ax,$5803
    mov     bl,On
    xor     bh,bh
    int     $21
    jc      @1
    xor     ax,ax
@1:
  end;

  function DosVersion : Word; Assembler;
    {-Return major DOS version number}
  asm
    mov     ah,$30
    int     $21
    xchg    ah,al
  end;

  function TopOfMemSeg : Word;
    {-Return segment of top of memory}
  var
    KBRAM : Word;
  begin
    asm
      int $12
      mov KBRAM,ax
    end;
    TopOfMemSeg := KBRAM shl 6;
  end;

  function FindHiMemViaDosLink : word;
    {-Return segment of first mcb in high memory, assuming DOS has linked it}
  var
    M : mcbptr;
  begin
    FindHiMemViaDosLink := 0;
    M := Mcb1;
    repeat
      if OS(M).S > $9FFF then begin
        FindHiMemViaDosLink := OS(M).S;
        exit;
      end;
      if M^.ID = 'Z' then
        exit;
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until False;
  end;

  function FindHiMemViaSearch : Word;
    {-Find start of high memory using a search technique}
  var
    Mseg : word;
    M : mcbptr;
    N : mcbptr;
    Done : boolean;
    Invalid : boolean;
  begin
    Mseg := TopOfMemSeg;
    Done := False;
    repeat
      M := Ptr(Mseg, 0);
      case M^.Id of
        'M' {, 'Z'} : {There must be at least 2 mcbs in high memory}
          begin
            {determine whether this is a valid chain of mcbs}
            N := M;
            Invalid := False;
            repeat
              case N^.Id of
                'M' :
                  if LongInt(OS(N).S)+N^.Len+1 <= $FFFF then
                    {next mcb won't land beyond $FFFF}
                    N := Ptr(OS(N).S+N^.Len+1, 0)
                  else
                    Invalid := true;
                'Z' :
                  begin
                    {found end of chain starting at M}
                    FindHiMemViaSearch := Mseg;
                    Done := True;
                  end;
              else
                Invalid := True;
              end;
            until Done or Invalid;
          end;
      end;
      if Mseg < $FFFF then
        inc(Mseg)
      else
        Done := True;
    until Done;
  end;

  function FindHiMemStart : word;
    {-Return segment of first mcb in high memory}
  var
    Segment : word;
    Size : word;
    Status : word;
  begin
    {assume failure}
    FindHiMemStart := 0;

    {try to use the DOS link function}
    if GetUmbLinkStatus then
      {high memory already linked}
      Segment := FindHiMemViaDosLink
    else begin
      {link high memory}
      Status := SetUmbLinkStatus(True);
      if Status = 0 then begin
        Segment := FindHiMemViaDosLink;
        Status := SetUmbLinkStatus(False);
      end else
        Segment := 0;
    end;
    if Segment <> 0 then begin
      FindHiMemStart := Segment;
      Exit;
    end;

    {assure XMS driver installed}
    if not XmsInstalled then
      Exit;

    {confirm that UMBs can be created}
    Status := AllocateUmbMem($FFFF, Segment, Size);
    case status of
      $B0, $B1 : ; {UMBs are possible, but not to allocate $FFFF paragraphs}
    else
      Exit;        {UMBs are not possible}
    end;

    {use an empirical search}
    FindHiMemStart := FindHiMemViaSearch;
  end;

  procedure MergeHiMemBlocks(HiMemSeg : Word);
    {-Merge adjacent blocks in high memory, starting with HiMemSeg}
  var
    M : McbPtr;
    N : McbPtr;
    Done : Boolean;
  begin
    if HiMemSeg = 0 then
      Exit;
    M := Ptr(HiMemSeg, 0);
    Done := False;
    repeat
      Done := (M^.Id = 'Z');
      if not Done then begin
        N := Ptr(OS(M).S+M^.Len+1, 0);
        if (M^.Psp = 0) and (N^.Psp = 0) then begin
          {This block and the next are both free}
          inc(M^.Len, N^.Len+1);
          M^.Id := N^.Id;
        end else
          M := N;
      end;
    until Done;
  end;

  function HexB(B : Byte) : String;
    {-Return hex string for byte}
  begin
    HexB[0] := #2;
    HexB[1] := Digits[B shr 4];
    HexB[2] := Digits[B and $F];
  end;

  function HexW(W : Word) : String;
    {-Return hex string for word}
  begin
    HexW[0] := #4;
    HexW[1] := Digits[Hi(W) shr 4];
    HexW[2] := Digits[Hi(W) and $F];
    HexW[3] := Digits[Lo(W) shr 4];
    HexW[4] := Digits[Lo(W) and $F];
  end;

  function HexPtr(P : Pointer) : string;
    {-Return hex string for pointer}
  begin
    HexPtr := HexW(OS(P).S)+':'+HexW(OS(P).O);
  end;

  function StUpcase(s : String) : String;
    {-Return the uppercase string}
  var
    i : Byte;
  begin
    for i := 1 to Length(s) do
      s[i] := UpCase(s[i]);
    StUpcase := s;
  end;

  function JustFilename(PathName : String) : String;
    {-Return just the filename of a pathname}
  var
    I : Word;
  begin
    I := Word(Length(PathName))+1;
    repeat
      Dec(I);
    until (PathName[I] in DosDelimSet) or (I = 0);
    JustFilename := Copy(PathName, I+1, 64);
  end;

  function JustName(PathName : String) : String;
    {-Return just the name (no extension, no path) of a pathname}
  var
    DotPos : Byte;
  begin
    PathName := JustFilename(PathName);
    DotPos := Pos('.', PathName);
    if DotPos > 0 then
      PathName := Copy(PathName, 1, DotPos-1);
    JustName := PathName;
  end;

  function Extend(S : String; Len : Byte) : String;
    {-Truncate or pad S to length Len}
  begin
    if Length(S) < Len then
      FillChar(S[Length(S)+1], Len-Length(S), ' ');
    S[0] := Char(Len);
    Extend := S;
  end;

  function SmartExtend(S : String; Len : Byte) : String;
    {-Truncate or pad S to length Len; end with '...' if truncated}
  begin
    if Length(S) > Len then
      SmartExtend := copy(S, 1, Len-3)+'...'
    else
      SmartExtend := Extend(S, Len);
  end;

  function Asc2Str(Name : NameArray) : String;
    {-Convert array[1..8] of char to string}
  var
    I : Integer;
  begin
    I := 1;
    while (I <= 8) and (Name[I] <> #0) and (Name[I] <> ' ') do begin
      Asc2Str[I] := Name[I];
      Inc(I);
    end;
    Asc2Str[0] := Char(I-1);
  end;

  procedure StripNonAscii(var S : String);
    {-Return an empty string if input contains non-ASCII characters}
  var
    I : Integer;
    Ok : Boolean;
  begin
    Ok := True;
    I := 1;
    while Ok and (I <= Length(S)) do begin
      case S[I] of
        #0..#31, #127, #166..#255 : Ok := False;
      end;
      Inc(I);
    end;
    if not Ok then
      S := '';
  end;

  function CommaIze(L : LongInt; Width : Byte) : String;
    {-Convert L to a string and add commas for thousands}
  var
    I : Word;
    Len : Word;
    S : String[19];
  begin
    Str(L, S);
    Len := Length(S);
    I := Len;
    while I > 1 do begin
      if (Len+1-I) mod 3 = 0 then
        insert(',', S, I);
      dec(I);
    end;
    while Length(S) < Width do
      insert(' ', S, 1);
    CommaIze := S;
  end;

  function HasEnvironment(HiMemSeg : Word; M : McbPtr) : Boolean;
    {-Return True if M has an associated environment block}
  var
    EnvSeg : Word;

    function HasEnv(Start : McbPtr) : Boolean;
    var
      N : McbPtr;
      Done : Boolean;
    begin
      N := Start;
      repeat
        if (N^.Psp = M^.Psp) and (N^.Len > 0) and (EnvSeg = OS(N).S+1) then begin
          HasEnv := True;
          Exit;
        end;
        Done := (N^.Id = 'Z');
        N := Ptr(OS(N).S+N^.Len+1, 0);
      until Done;
      HasEnv := False;
    end;

  begin
    EnvSeg := MemW[M^.Psp:$2C];
    if HasEnv(Mcb1) then
      HasEnvironment := True
    else if (HiMemSeg <> 0) and HasEnv(Ptr(HiMemSeg, 0)) then
      HasEnvironment := True
    else
      HasEnvironment := False;
  end;

  function ValidPsp(HiMemSeg, PspSeg, PspLen : Word) : Boolean;
    {-Return True if PspSeg is a valid, existing Psp}

    function ValidP(Start : McbPtr) : Boolean;
    var
      N : McbPtr;
      Done : Boolean;
    begin
      N := Start;
      repeat
        if (N^.Psp = PspSeg) and (N^.Len = PspLen) then begin
          ValidP := True;
          Exit;
        end;
        Done := (N^.Id = 'Z');
        N := Ptr(OS(N).S+N^.Len+1, 0);
      until Done;
      ValidP := False;
    end;

  begin
    if ValidP(Mcb1) then
      ValidPsp := True
    else if (HiMemSeg <> 0) and ValidP(Ptr(HiMemSeg, 0)) then
      ValidPsp := True
    else
      ValidPsp := False;
  end;

  function NameFromEnv(M : McbPtr) : String;
    {-Return M's name from its environment (already known to exist)}
  type
    CharArray = array[0..32767] of Char;
    CharArrayPtr = ^CharArray;
  var
    E : Word;
    Eptr : CharArrayPtr;
    Name : String[79];
    Nlen : Byte absolute Name;
  begin
    Eptr := Ptr(MemW[M^.Psp:$2C], 0);
    E := 0;
    repeat
      if Eptr^[E] = #0 then begin
        Inc(E);
        if Eptr^[E] = #0 then begin
          {found end of environment}
          Inc(E, 3);
          Nlen := 0;
          while (Nlen < 63) and (Eptr^[E] <> #0) do begin
            Inc(Nlen);
            Name[Nlen] := Eptr^[E];
            Inc(E);
          end;
          StripNonAscii(Name);
          NameFromEnv := JustName(Name);
          Exit;
        end;
      end;
      Inc(E);
    until (E > 32767);
    NameFromEnv := '';
  end;

  function NameFromMcb(M : McbPtr) : String;
    {-Return name from the Mcb (DOS 4+ only)}
  var
    Name : String[79];
  begin
    Name := Asc2Str(M^.Name);
    StripNonAscii(Name);
    NameFromMcb := Name;
  end;

  function MasterCommandSeg(HiMemSeg : Word) : Word;
    {-Return PSP segment of master COMMAND.COM in low memory}
  var
    MCS : Word;

    function MasterCommandS(Start : McbPtr) : Word;
    var
      N : McbPtr;
      Done : Boolean;
    begin
      N := Start;
      repeat
        if (OS(N).S+1 = N^.Psp) and (MemW[N^.Psp:$16] = N^.Psp) then begin
          MasterCommandS := N^.Psp;
          Exit;
        end;
        Done := (N^.Id = 'Z');
        N := Ptr(OS(N).S+N^.Len+1, 0);
      until Done;
      MasterCommandS := 0;
    end;

  begin
    MCS := 0;
    if HiMemSeg <> 0 then
      MCS := MasterCommandS(Ptr(HiMemSeg, 0));
    if MCS = 0 then
      MCS := MasterCommandS(MCB1);
    MasterCommandSeg := MCS;
  end;

  function WatchPspSeg : Word; assembler;
    {-Find copy of WATCH.COM in memory, returning its PSP segment or zero}
  asm
    mov ax,$7761     {id call to WATCH}
    int $21
    jc @1
    cmp ax,$6177     {WATCH flips ah and al if installed}
    jne @1
    mov ax,bx        {WATCH returns its own CS in BX}
    jmp @2
@1: xor ax,ax        {not installed}
@2:
  end;

  procedure FindTheBlocks(UseLoMem : Boolean;
                          HiMemSeg : Word;
                          var Blocks : BlockArray;
                          var BlockMax : BlockType;
                          var StartMcb : Word);
    {-Scan memory for the allocated memory blocks}
  const
    MidBlockID = $4D;         {Byte DOS uses to identify part of MCB chain}
    EndBlockID = $5A;         {Byte DOS uses to identify last block of MCB chain}
  var
    mcbSeg : Word;            {Segment address of current MCB}
    nextSeg : Word;           {Computed segment address for the next MCB}
    gotFirst : Boolean;       {True after first MCB is found}
    gotLast : Boolean;        {True after last MCB is found}
    idbyte : Byte;            {Byte that DOS uses to identify an MCB}

    procedure StoreTheBlock(SaveBlock : Boolean;
                            var mcbSeg, nextSeg : Word;
                            var gotFirst, gotLast : Boolean);
      {-Store information regarding the memory block}
    var
      nextID : Byte;
      PspAdd : Word;       {Segment address of the current PSP}
      mcbLen : Word;       {Size of the current memory block in paragraphs}

    begin

      PspAdd := MemW[mcbSeg:1]; {Address of program segment prefix for MCB}
      mcbLen := MemW[mcbSeg:3]; {Size of the MCB in paragraphs}
      nextSeg := Succ(mcbSeg+mcbLen); {Where the next MCB should be}
      nextID := Mem[nextSeg:0];

      if gotLast or (nextID = EndBlockID) or (nextID = MidBlockID) then
        if BlockMax < MaxBlocks then begin
          gotFirst := True;
          if SaveBlock then begin
            inc(BlockMax);
            with Blocks[BlockMax] do begin
              mcb := mcbSeg;
              psp := PspAdd;
            end;
          end;
        end;
    end;

    procedure ScanBlocks(SaveBlock : Boolean);
      {-Scan memory until ending block is found}
    begin
      repeat
        idbyte := Mem[mcbSeg:0];
        if idbyte = MidBlockID then begin
          StoreTheBlock(SaveBlock, mcbSeg, nextSeg, gotFirst, gotLast);
          if gotFirst then
            mcbSeg := nextSeg
          else
            inc(mcbSeg);
        end else if gotFirst and (idbyte = EndBlockID) then begin
          gotLast := True;
          StoreTheBlock(SaveBlock, mcbSeg, nextSeg, gotFirst, gotLast);
        end else
          {Start block was invalid}
          gotLast := True;
      until gotLast;
    end;

  begin
    BlockMax := 0;
    StartMCB := OS(MCB1).S;

    mcbSeg := StartMCB;
    gotFirst := False;
    gotLast := False;
    ScanBlocks(UseLoMem);

    if HiMemSeg <> 0 then begin
      mcbSeg := HiMemSeg;
      gotFirst := False;
      gotLast := False;
      ScanBlocks(True);
    end;
  end;

  const
    KbdStart = $1E;
    KbdEnd = $3C;
  var
    KbdHead : Word absolute $40 : $1A;
    KbdTail : Word absolute $40 : $1C;

  procedure StuffKey(W : Word);
    {-Stuff one key into the keyboard buffer}
  var
    SaveKbdTail : Word;
  begin
    SaveKbdTail := KbdTail;
    if KbdTail = KbdEnd then
      KbdTail := KbdStart
    else
      Inc(KbdTail, 2);
    if KbdTail = KbdHead then
      KbdTail := SaveKbdTail
    else
      MemW[$40:SaveKbdTail] := W;
  end;

  procedure StuffKeys(Keys : string; ClearFirst : Boolean);
    {-Stuff up to 16 keys into keyboard buffer}
  var
    Len : Byte;
    I : Byte;
  begin
    if ClearFirst then
      KbdTail := KbdHead;
    Len := Length(Keys);
    if Len > 16 then
      Len := 16;
    for I := 1 to Length(Keys) do
      StuffKey(Ord(Keys[I]));
  end;

  function ExistFile(path : String) : Boolean;
    {-Return true if file exists}
  var
    F : file;
  begin
    Assign(F, path);
    Reset(F);
    if IoResult = 0 then begin
      ExistFile := True;
      Close(F);
    end else
      ExistFile := False;
  end;

  function NextArg(S : String; var SPos : Word) : String;
    {-Return next argument beginning at SPos in S.
      Increment SPos to point past the argument.
      Arguments are delimited by white space and '/'}
  var
    Start : Word;

    function Delimiter(Ch : Char) : Boolean;
    begin
      case Ch of
        #0..' ', '/' : Delimiter := True;
      else
        Delimiter := False;
      end;
    end;

  begin
    {Skip leading white space}
    while (SPos <= Length(S)) and (S[SPos] <= ' ') do
      inc(SPos);

    {Exit if beyond end of string}
    if SPos > Length(S) then begin
      NextArg := '';
      Exit;
    end;

    {Find end of this argument}
    Start := SPos;
    inc(SPos);
    while (SPos <= Length(S)) and not Delimiter(S[Spos]) do
      inc(SPos);

    {Return the string}
    NextArg := Copy(S, Start, SPos-Start);
  end;

function GetCDCount(var CDInfo : CDROMDeviceArray) : Word; Assembler;
  {-Return number of MSCDEX CD-ROMs and info about them}
asm
  xor bx,bx
  mov ax,$1500
  int $2F
  mov ax,bx
  or ax,ax
  jz @1
  push ax
  mov ax,$1501
  les bx,CDInfo
  int $2F
  pop ax
@1:
end;

begin
  DosVT := DosVersion;
  DosList := GetDosListPtr;     {pointer to dos list of lists}
  Mcb1 := Ptr(MemW[OS(DosList).S:OS(DosList).O-2], 0); {first Mcb}
end.